#!/usr/bin/perl

package Swignition::Export::Alarm;
use Swignition::Export;
use Swignition::Export::Contact;
use MIME::Base64;

sub is
{
	my $subject = shift;
	return unless ($subject);
	return unless (ref $subject eq 'Swignition::RDFModel::Subject');	
	return
		unless (defined $subject->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'));
	foreach my $Type ( @{$subject
		->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type')
		->valObjects} )
	{
		my $type = $Type->toString;
		return 1
			if (($type eq 'http://www.w3.org/2002/12/cal/ical#Valarm')
			||  ($type eq 'urn:ietf:rfc:2445#Valarm'));
	}
	return;
}

sub outputs
{
	return [
		{
			code  => 'ICS',
			name  => 'iCalendar',
			type  => 'text/directory',
			multi => 1
		}
	];
}

sub outICS
{
	return "BEGIN:VCALENDAR\r\n"
		. _outICS(@_)
		. "END:VCALENDAR\r\n";
}

sub multiICS
{
	my $triples = shift;
	my $rv = '';
	foreach my $s (keys %$triples)
	{
		$rv .= _outICS($triples, $s)
			if (defined $triples->{$s} && is($triples->{$s}));
	}

	return "BEGIN:VCALENDAR\r\n"
		. $rv
		. "END:VCALENDAR\r\n";
}

sub _outICS
{
	my $triples = shift;
	my $subject = shift;
	my $S = findSubject($triples, $subject);
	my @rv = (['BEGIN','VALARM']);

	# UID - I don't think this is actually allowed, but what the hey?!
	my $uid = firstOf($S, 'urn:ietf:rfc:2445#uid',
		'http://www.w3.org/2002/12/cal/ical#uid',
		'http://purl.org/dc/terms/identifier',
		'http://purl.org/dc/elements/1.1/identifier');
	push @rv, ['UID', $uid]
		if ($uid);
	
	# Summary
	my $summary = firstOfLiteral($S,
		['urn:ietf:rfc:2445#summary',
		'http://www.w3.org/2002/12/cal/ical#summary',
		'http://purl.org/dc/terms/title',
		'http://purl.org/dc/elements/1.1/title'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['SUMMARY', $summary]
		if ($summary);
	
	# Trigger
	my $trigger = firstOfLiteral($S,
		['urn:ietf:rfc:2445#trigger',
		'http://www.w3.org/2002/12/cal/ical#trigger'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['TRIGGER', $trigger]
		if ($trigger);
	
	# Action
	my $action = firstOfLiteral($S,
		['urn:ietf:rfc:2445#action',
		'http://www.w3.org/2002/12/cal/ical#action'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['ACTION', uc($action)]
		if ($action);
	
	# Description
	my $desc = firstOfLiteral($S,
		['urn:ietf:rfc:2445#description',
		'http://www.w3.org/2002/12/cal/ical#description',
		'http://purl.org/dc/terms/description',
		'http://purl.org/dc/elements/1.1/description',
		'http://purl.org/dc/terms/abstract'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DESCRIPTION', $desc]
		if ($desc);
	
	# Duration
	my $duration = firstOfLiteral($S,
		['urn:ietf:rfc:2445#duration',
		'http://www.w3.org/2002/12/cal/ical#duration'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DURATION', $duration]
		if ($duration);
	
	# Repeat
	my $repeat = firstOfLiteral($S,
		['urn:ietf:rfc:2445#repeat',
		'http://www.w3.org/2002/12/cal/ical#repeat'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['REPEAT', sprintf('%d', $repeat)]
		if ($repeat);
	
	# Attach
	my @attachments = allOf($S, 'urn:ietf:rfc:2445#attach',
		'http://www.w3.org/2002/12/cal/ical#attach',
		'http://www.iana.org/assignments/relation/enclosure',
		'http://purl.org/dc/terms/hasPart');
	foreach my $att (@attachments)
	{
		my $Att = findSubject($triples, $att);
		if ($Att)
		{
			my $E = $triples->{$att};
			my $e = $E->firstVal('http://www.iana.org/assignments/relation/enclosure');
			if ($e)
				{ push @rv, ['ATTACH;VALUE=uri',$e]; }
			else
				{ push @rv, ['ATTACH;VALUE=uri',$Att->uri]; }
		}
		else
		{
			push @rv, ['ATTACH;VALUE=uri',$att];
		}
	}

	# Attendees, Contact, Organizer
	push @rv, Swignition::Export::CalComponent::_people($triples, $S, 'a');

	# Done.
	push @rv, ['END','VALARM'];
	
	# Convert to text/directory syntax.
	my $rv = '';
	foreach my $line (@rv)
	{
		my ($k, $v, $soft) = @{$line};
		
		if ($k =~ /VALUE.uri$/i && $v =~ /^data\:/)
		{
			my $uri = URI->new($v);
			$v = encode_base64($uri->data, '');
			$k =~ s/VALUE.uri$/ENCODING\=b/i;
			$k .= ';TYPE='.$uri->media_type
				if ($uri->media_type);
		}
		
		$v =~ s/\\/\\\\/g;
		$v =~ s/\r?\n/\\n/g;
		unless ($soft)
		{
			$v =~ s/\;/\\\;/g;
			$v =~ s/\,/\\\,/g;
		}
		
		$rv .= "$k:$v\r\n";
	}
	return $rv;
}

1;
